home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / modula2 / module / edierebi.mod < prev    next >
Encoding:
Modula Implementation  |  1995-11-25  |  10.8 KB  |  340 lines
  1. IMPLEMENTATION MODULE  EdiereBierListe;
  2.  
  3. (********************** IMPORT ***************************************)
  4.  
  5. FROM BlRscInc IMPORT SaveFileName, EINGABE(* TREE *), NAME, UEBERTRG, BSTRICH,
  6.       LSTRICH, PREVIOUS, NEXT, CANCLABR, OKABR,LOESCHEN ;(* OBJECTs in TREE #4 *)
  7.  
  8. FROM SYSTEM IMPORT VAL,ADDRESS;
  9. FROM AES IMPORT FormAlert,ResourceGetAddr;
  10. FROM EasyDialog IMPORT DoMoveDialog,and,GetText,SetText,IsSelected;
  11. FROM ConvertStr IMPORT StrToInt, StrToLongInt,IntToStr,LongIntToStr;
  12. FROM Strings IMPORT ClearStr,IsEmptyStr,EqualStr,LeftStr,SubStr,Length,
  13.                     Concat;
  14. FROM Bliste IMPORT List,AtFirst,AtLast,Empty,Next,Prev,AppendElement,RemoveElement,Kunde,
  15.                    First,MakeList,KillList,GetValue,SetValue,STRING15;
  16. FROM XStrings IMPORT FillStr;
  17. FROM PreisErfassung IMPORT VerkaufsPreis;
  18. FROM InOut IMPORT WriteString,WriteLn,WriteInt,ReadInt,Done,
  19.                   ReadLine;(* OpenOutput,CloseOutput,OpenInput,CloseInput;*)
  20.  
  21. FROM LongInOut IMPORT WriteLongInt,ReadLongInt;
  22.  
  23. (******************************** VAR **********************************)
  24. VAR AlertString1,
  25.     AlertString2,
  26.     AlertString3,
  27.     AlertString5,
  28.     AlertString6,
  29.     AlertString4 :ARRAY [0..127] OF CHAR;
  30.     NewStr : STRING15;
  31.     Customer  :Kunde;
  32. (******************************* BEGIN PROCEDUREs ***********************)
  33. PROCEDURE ComputeCustomer;
  34. VAR OK:BOOLEAN;
  35. BEGIN
  36.    OK:=GetValue(BierListe,Customer);
  37.    Customer.Rechnung:=
  38.        Customer.Uebertrag+
  39.        VAL(LONGINT,(Customer.Biere*VerkaufsPreis.BierPreis))+
  40.        VAL(LONGINT,(Customer.Limos*VerkaufsPreis.LimoPreis));
  41.    SetValue(BierListe,Customer);
  42. END ComputeCustomer;
  43.  
  44. PROCEDURE SaveCustomer;
  45. BEGIN
  46.    ComputeCustomer;
  47.    WriteString(Customer.Name);
  48.    WriteLn;
  49.    WriteLongInt(Customer.Uebertrag,10);
  50.    WriteInt(Customer.Biere,5);
  51.    WriteInt(Customer.Limos,5);
  52.    WriteLongInt(Customer.Rechnung,10);
  53.    WriteInt(Customer.BiereIsg,5);
  54.    WriteInt(Customer.LimosIsg,5);
  55.    WriteLongInt(Customer.Umsatz,10);
  56.    WriteLn;
  57. END SaveCustomer;
  58.  
  59. PROCEDURE LoadCustomerOld():BOOLEAN;
  60. VAR   LIdummy:LONGINT;
  61.       Idummy :INTEGER;
  62. BEGIN
  63.     ReadLine(Customer.Name);
  64.     ReadLongInt(Customer.Uebertrag);
  65.     ReadInt(Customer.Biere);
  66.     ReadInt(Customer.Limos);
  67.     ReadLongInt(Customer.Rechnung);
  68.     ReadInt(Customer.BiereIsg);
  69.     ReadInt(Customer.LimosIsg);
  70.     ReadLongInt(Customer.Umsatz);
  71.     RETURN Done;
  72. END LoadCustomerOld;
  73.  
  74.  
  75. PROCEDURE LoadCustomer():BOOLEAN;
  76. VAR   LIdummy:LONGINT;
  77.       BisgDummy,
  78.       LisgDummy :INTEGER;
  79. BEGIN
  80.     ReadLine(Customer.Name);
  81.     ReadLongInt(LIdummy);(* alter Übertrag*)
  82.     (** Weil die Werte nicht geladen werden, mit 0 belegen*)
  83.     Customer.Rechnung:=0; Customer.Biere:=0; Customer.Limos:=0;
  84.  
  85.     ReadInt(BisgDummy); (* Biere beiletzter Rechnung  *)
  86.     ReadInt(LisgDummy); (* Limos bei letzter Rechnung *)
  87.  
  88.     ReadLongInt(Customer.Uebertrag);(* Alte Rechnung = NeuerÜbertrag*)
  89.     ReadInt(Customer.BiereIsg);
  90.     Customer.BiereIsg:=Customer.BiereIsg+BisgDummy;
  91.     ReadInt(Customer.LimosIsg);
  92.     Customer.LimosIsg:=Customer.LimosIsg+LisgDummy;
  93.     ReadLongInt(Customer.Umsatz);
  94.     Customer.Umsatz:= Customer.Umsatz+Customer.Rechnung;
  95.  
  96.     RETURN Done
  97. END LoadCustomer;
  98.  
  99. PROCEDURE SaveList;
  100. VAR OK :BOOLEAN;
  101. BEGIN
  102.    First(BierListe);
  103.    WHILE ~AtLast(BierListe) DO
  104.        OK:=GetValue(BierListe,Customer);
  105.        SaveCustomer;
  106.        Next(BierListe);
  107.    END(*WHILE*);
  108.    OK:=GetValue(BierListe,Customer);
  109.    (*der letzte auch noch*)
  110.    SaveCustomer;
  111. END SaveList;
  112.  
  113.  
  114.  
  115. PROCEDURE LoadList;
  116. VAR OK: BOOLEAN;
  117. BEGIN
  118.    KillList(BierListe);
  119.    MakeList(BierListe);
  120.    AnfangsUebertrag:=0D;
  121.    IF Done THEN
  122.    WHILE LoadCustomer() DO
  123.       AppendElement(BierListe);
  124.       SetValue(BierListe,Customer);
  125.       AnfangsUebertrag:= AnfangsUebertrag+Customer.Uebertrag;
  126.    END(*WHILE*);
  127.    END(*IF*);
  128. END LoadList;
  129.  
  130. PROCEDURE LoadOldList;
  131. BEGIN
  132.    KillList(BierListe);
  133.    MakeList(BierListe);
  134.    AnfangsUebertrag:=0D;
  135.    IF Done THEN
  136.    WHILE LoadCustomerOld() DO
  137.       AppendElement(BierListe);
  138.       SetValue(BierListe,Customer);
  139.       AnfangsUebertrag:= AnfangsUebertrag+Customer.Uebertrag;
  140.    END(*WHILE*);
  141.    END(*IF*);
  142. END LoadOldList;
  143.  
  144.  
  145. PROCEDURE Editiere;
  146.  
  147. VAR EingabeDialogAddr   :ADDRESS;
  148.     DiaReturn,i,
  149.     FormRet       :INTEGER;
  150.     String        :STRING15;
  151.     String7       :ARRAY [0..6] OF CHAR;
  152.     UEString      :ARRAY [0..4] OF CHAR;
  153.     BSString      :ARRAY [0..1] OF CHAR;
  154.     LSString      :ARRAY [0..1] OF CHAR;
  155.     Null          :ARRAY [0..0] OF CHAR;
  156.     New,OK        :BOOLEAN;
  157.  
  158. PROCEDURE ValidInput():BOOLEAN;
  159. VAR VglStr1,
  160.     VglStr2 : ARRAY[0..17] OF CHAR;
  161.     IntStr  : ARRAY[0..1]  OF CHAR;
  162.     OK      : BOOLEAN;
  163.     Pf      : LONGINT;
  164.     StringLaenge,BierStriche,LimoStriche:INTEGER;
  165. BEGIN
  166.    VglStr1:='';VglStr2:='';
  167.    BierStriche:=0;Pf:=0;LimoStriche:=0;
  168.    IF IsEmptyStr(String) THEN RETURN FALSE END(*IF*);
  169.    LeftStr(String,15,VglStr1,OK);
  170.    IF IsEmptyStr(VglStr1) THEN RETURN FALSE END(*IF*);
  171.    VglStr2:='_________________';
  172.    LeftStr(VglStr2,15,VglStr2,OK);
  173.  
  174.    IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
  175.    VglStr2:='                 ';
  176.    LeftStr(VglStr2,15,VglStr2,OK);
  177.  
  178.    IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
  179.    StrToLongInt(UEString,Pf,OK);
  180.    StrToInt(BSString,BierStriche,OK);
  181.    StrToInt(LSString,LimoStriche,OK);
  182.    (************
  183.    WriteLongInt(Pf,5);WriteInt(BierStriche,5);WriteInt(LimoStriche,5);WriteLn;
  184.    **************)
  185.    IF New THEN
  186.       Customer.Rechnung:=0;
  187.       Customer.BiereIsg:=0;
  188.       Customer.LimosIsg:=0;
  189.       Customer.Umsatz:=0;
  190.  
  191.    ELSE
  192.       OK:=GetValue(BierListe,Customer);
  193.       StringLaenge:=Length(Customer.Name);
  194.       LeftStr(VglStr1,StringLaenge,VglStr1,OK);
  195.       IF ~EqualStr(VglStr1,Customer.Name) THEN
  196.              FormRet:=FormAlert(1,AlertString4);
  197.              IF FormRet#1 THEN
  198.                 RETURN FALSE
  199.              ELSE
  200.                 New:=TRUE
  201.              END(*IF*);
  202.       END(*IF*);
  203.    END(*IF*);
  204.    IF New THEN
  205.       Customer.Name:=String;
  206.    END(*IF*);
  207.    Customer.Uebertrag:=Pf;
  208.    Customer.Biere:=BierStriche;
  209.    Customer.Limos:=LimoStriche;
  210.    SetValue(BierListe,Customer);
  211.    RETURN TRUE
  212. END ValidInput;
  213.  
  214.  
  215. BEGIN
  216.     ResourceGetAddr(0,EINGABE,EingabeDialogAddr);
  217.     Null[0]:='0';
  218.     IF Empty(BierListe) THEN
  219.        AppendElement(BierListe);
  220.        Customer.Name:=NewStr;
  221.        Customer.Uebertrag:=0D;
  222.        Customer.Biere:=0;
  223.        Customer.Limos:=0;
  224.        Customer.Rechnung:=0D;
  225.        Customer.BiereIsg:=0;
  226.        Customer.LimosIsg:=0;
  227.        Customer.Umsatz:=0D;
  228.        SetValue(BierListe,Customer);
  229.        New:=TRUE;
  230.     ELSE
  231.        First(BierListe);
  232.        New:=FALSE
  233.     END(*IF*);
  234.     REPEAT
  235.       IF ~New THEN
  236.           OK:=GetValue(BierListe,Customer);
  237.           SetText(NAME,EingabeDialogAddr,Customer.Name);
  238.           IntToStr(Customer.Biere,3,String7,OK);
  239.           SubStr(String7,2,2,String7,OK);
  240.           WHILE  Length(String7)<2 DO
  241.               Concat(Null,String7,String7,OK);
  242.           END(*WHILE*);
  243.           SubStr(String7,0,2,BSString,OK);
  244.           SetText(BSTRICH,EingabeDialogAddr,BSString);
  245.           LongIntToStr(Customer.Limos,3,String7,OK);
  246.           SubStr(String7,2,2,String7,OK);
  247.           WHILE  Length(String7)<2 DO
  248.               Concat(Null,String7,String7,OK);
  249.           END(*WHILE*);
  250.           SubStr(String7,0,2,LSString,OK);
  251.           SetText(LSTRICH,EingabeDialogAddr,LSString);
  252.           IntToStr(Customer.Uebertrag,3,String7,OK);
  253.           SubStr(String7,2,5,String7,OK);
  254.           WHILE  Length(String7)<5 DO
  255.               Concat(Null,String7,String7,OK);
  256.           END(*WHILE*);
  257.           SubStr(String7,0,5,UEString,OK);
  258.           SetText(UEBERTRG,EingabeDialogAddr,UEString);
  259.       ELSE
  260.          (*   SetText(NAME,EingabeDialogAddr,'________________');*)
  261.             SetText(NAME,EingabeDialogAddr,0C);
  262.             SetText(UEBERTRG,EingabeDialogAddr,0C);
  263.             SetText(BSTRICH,EingabeDialogAddr,0C);
  264.             SetText(LSTRICH,EingabeDialogAddr,0C);
  265.       END(*IF*);
  266.       DiaReturn:=DoMoveDialog(EingabeDialogAddr,NAME);
  267.       GetText(NAME,EingabeDialogAddr,String);
  268.       GetText(UEBERTRG,EingabeDialogAddr,UEString);
  269.       GetText(BSTRICH,EingabeDialogAddr,BSString);
  270.       GetText(LSTRICH,EingabeDialogAddr,LSString);
  271.       IF DiaReturn=LOESCHEN THEN
  272.            FormRet:=FormAlert(2,AlertString5);
  273.            IF FormRet=1 THEN
  274.                   RemoveElement(BierListe);
  275.                   New:=FALSE
  276.            END(*IF*);
  277.       ELSIF  DiaReturn#CANCLABR THEN
  278.         IF  ValidInput() THEN
  279.           IF DiaReturn=PREVIOUS THEN
  280.              IF ~Empty(BierListe) THEN
  281.                New:=FALSE;
  282.                IF AtFirst(BierListe) THEN
  283.                   FormRet:=FormAlert(1,AlertString2);
  284.                ELSE
  285.                   Prev(BierListe);
  286.                END(*IF*);
  287.              ELSE
  288.                New:=TRUE
  289.              END(*IF*);
  290.           ELSIF  DiaReturn=NEXT THEN
  291.              IF AtLast(BierListe) THEN
  292.                FormRet:=FormAlert(1,AlertString3);
  293.                IF FormRet=1 THEN
  294.                   AppendElement(BierListe);
  295.                   Customer.Name:=NewStr;
  296.                   Customer.Uebertrag:=0D;
  297.                   Customer.Biere:=0;
  298.                   Customer.Limos:=0;
  299.                   Customer.Rechnung:=0D;
  300.                   Customer.BiereIsg:=0;
  301.                   Customer.LimosIsg:=0;
  302.                   Customer.Umsatz:=0D;
  303.                   SetValue(BierListe,Customer);
  304.                   New:=TRUE;
  305.                ELSE
  306.                   DiaReturn:=OKABR;
  307.                END(*IF*);
  308.              ELSE
  309.                Next(BierListe);
  310.                New:=FALSE;
  311.              END(*IF*);
  312.           END(*IF*); (*DiaRet=?*)
  313.         ELSIF EqualStr(Customer.Name,NewStr) THEN
  314.              FormRet:=FormAlert(2,AlertString6);
  315.              IF FormRet=2 THEN
  316.                 RemoveElement(BierListe);
  317.                 New:=FALSE
  318.              ELSE
  319.                 DiaReturn:=NEXT;(* ~OKABR *)
  320.              END(*IF*);
  321.         ELSE (* Valid Input ? *)
  322.              FormRet:=FormAlert(1,AlertString1);
  323.         END(*IF*);
  324.       END(*IF*); (*DiaRet#Cancel*)
  325.     UNTIL DiaReturn=OKABR;
  326. END Editiere;
  327.  
  328. BEGIN
  329.    AlertString1 :='[3][Sie haben einen|falschen Namen eingegeben][Nochmal]';
  330.    AlertString2 :='[1][Erster Eintrag!|Es gibt keinen|Vorgänger][  OK  ]';
  331.    AlertString3 :='[2][Letzter Eintrag|Neuen Kunden hinzufügen?][  Ja  | Nein ]';
  332.    AlertString5 :='[2][ Eintrag|wirklich löschen?][  Ja  | Nein ]';
  333.    AlertString4 :='[3][Der Name wurde geändert|Neuen Namen Verwenden?][  Ja  | Nein ]';
  334.    AlertString6 :='[2][Sie haben einen|falschen Namen eingegeben|Eingabe wiederholen?][ Ja | Nein ]';
  335.  
  336.    NewStr:='Neuer Kunde';
  337.    AnfangsUebertrag:=0D;
  338.    MakeList(BierListe);
  339. END EdiereBierListe.
  340.